An Invitation to the Roland World of Music/Roland - An Invitation To The Roland World Of Music.bin/vb/cooltool/mfplayr/mfplayr.frm

Text File | 1995-05-26 | 37KB | 1,202 lines

VERSION 2.00
Begin Form Form1
   AutoRedraw      =   -1  'True
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   3  'Fixed Double
   Caption         =   "MFPlayer Example"
   ClientHeight    =   3990
   ClientLeft      =   1305
   ClientTop       =   1995
   ClientWidth     =   9720
   Height          =   4680
   Icon            =   MFPLAYR.FRX:0000
   Left            =   1245
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   3990
   ScaleWidth      =   9720
   Top             =   1365
   Width           =   9840
   Begin Frame Frame2
      BackColor       =   &H00C0C0C0&
      Caption         =   "Playback Controls"
      Height          =   1095
      Left            =   60
      TabIndex        =   14
      Top             =   2760
      Width           =   9495
      Begin CommandButton CmdQueue
         Caption         =   "Queue "
         Enabled         =   0   'False
         Height          =   675
         Left            =   120
         TabIndex        =   20
         Top             =   300
         Width           =   1035
      End
      Begin Frame Frame5
         BackColor       =   &H00C0C0C0&
         Caption         =   "MIDI Output"
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   8.25
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         Height          =   795
         Left            =   3900
         TabIndex        =   18
         Top             =   180
         Width           =   3195
         Begin ComboBox OutputDevCombo
            Height          =   300
            Left            =   180
            Style           =   2  'Dropdown List
            TabIndex        =   19
            Top             =   300
            Width           =   2835
         End
      End
      Begin CommandButton CmdStop
         Caption         =   "Stop"
         Height          =   675
         Left            =   2520
         TabIndex        =   17
         Top             =   300
         Width           =   1035
      End
      Begin CommandButton CmdPlay
         Caption         =   "Play"
         Height          =   675
         Left            =   1320
         TabIndex        =   16
         Top             =   300
         Width           =   1035
      End
      Begin Frame Frame3
         BackColor       =   &H00C0C0C0&
         Caption         =   "Playback Rate"
         FontBold        =   0   'False
         FontItalic      =   0   'False
         FontName        =   "MS Sans Serif"
         FontSize        =   8.25
         FontStrikethru  =   0   'False
         FontUnderline   =   0   'False
         Height          =   795
         Left            =   7260
         TabIndex        =   15
         Top             =   180
         Width           =   2175
         Begin HSlider PlaybackRateSlider
            BackColor       =   &H00C0C0C0&
            BevelInner      =   1  'Raised
            BevelOuter      =   0  'None
            BevelWidth      =   2
            BorderWidth     =   2
            Gap             =   3
            Height          =   435
            LargeChange     =   10
            Left            =   60
            LinkControl     =   "MIDIOutput1"
            LinkProperty    =   "PlaybackRate"
            Max             =   100
            Min             =   -100
            ThumbHeight     =   310
            ThumbStyle      =   2  'Pointed Down
            ThumbWidth      =   120
            TickColor       =   &H00000000&
            TickCount       =   20
            TickLength      =   4
            TickMarks       =   2  'Bottom
            TickWidth       =   1
            Top             =   240
            TrackBevel      =   2  'Inset
            TrackWidth      =   2
            Value           =   0
            Width           =   2055
         End
      End
   End
   Begin MIDIFile MIDIFile1
      Filename        =   ""
      Left            =   60
      ReadOnly        =   0   'False
      Top             =   3900
   End
   Begin Frame Frame1
      BackColor       =   &H00C0C0C0&
      Caption         =   "MIDI File Track  -- VU Meters"
      Height          =   1845
      Left            =   0
      TabIndex        =   1
      Top             =   120
      Width           =   8715
      Begin VIndicator VIndicator1
         BackColor       =   &H00808080&
         BevelInner      =   0  'None
         BevelOuter      =   1  'Raised
         BevelWidth      =   1
         Border          =   1  'Single Width
         BorderWidth     =   1
         Height          =   1515
         Index           =   0
         ItemBackColor   =   &H00000000&
         ItemCount1      =   7
         ItemCount2      =   4
         ItemCount3      =   3
         ItemForeColor1  =   &H0000FF00&
         ItemForeColor2  =   &H0000FFFF&
         ItemForeColor3  =   &H000000FF&
         Left            =   180
         LinkControl     =   ""
         LinkProperty    =   ""
         Max             =   128
         Min             =   1
         ThreeD          =   -1  'True
         Top             =   300
         Value           =   0
         Width           =   435
      End
      Begin VIndicator VIndicator1
         BackColor       =   &H00808080&
         BevelInner      =   0  'None
         BevelOuter      =   1  'Raised
         BevelWidth      =   1
         Border          =   1  'Single Width
         BorderWidth     =   1
         Height          =   1515
         Index           =   1
         ItemBackColor   =   &H00000000&
         ItemCount1      =   7
         ItemCount2      =   4
         ItemCount3      =   3
         ItemForeColor1  =   &H0000FF00&
         ItemForeColor2  =   &H0000FFFF&
         ItemForeColor3  =   &H000000FF&
         Left            =   900
         LinkControl     =   ""
         LinkProperty    =   ""
         Max             =   128
         Min             =   1
         ThreeD          =   -1  'True
         Top             =   300
         Value           =   0
         Width           =   435
      End
      Begin VIndicator VIndicator1
         BackColor       =   &H00808080&
         BevelInner      =   0  'None
         BevelOuter      =   1  'Raised
         BevelWidth      =   1
         Border          =   1  'Single Width
         BorderWidth     =   1
         Height          =   1515
         Index           =   2
         ItemBackColor   =   &H00000000&
         ItemCount1      =   7
         ItemCount2      =   4
         ItemCount3      =   3
         ItemForeColor1  =   &H0000FF00&
         ItemForeColor2  =   &H0000FFFF&
         ItemForeColor3  =   &H000000FF&
         Left            =   1620
         LinkControl     =   ""
         LinkProperty    =   ""
         Max             =   128
         Min             =   1
         ThreeD          =   -1  'True
         Top             =   300
         Value           =   0
         Width           =   435
      End
      Begin VIndicator VIndicator1
         BackColor       =   &H00808080&
         BevelInner      =   0  'None
         BevelOuter      =   1  'Raised
         BevelWidth      =   1
         Border          =   1  'Single Width
         BorderWidth     =   1
         Height          =   1515
         Index           =   3
         ItemBackColor   =   &H00000000&
         ItemCount1      =   7
         ItemCount2      =   4
         ItemCount3      =   3
         ItemForeColor1  =   &H0000FF00&
         ItemForeColor2  =   &H0000FFFF&
         ItemForeColor3  =   &H000000FF&
         Left            =   2340
         LinkControl     =   ""
         LinkProperty    =   ""
         Max             =   128
         Min             =   1
         ThreeD          =   -1  'True
         Top             =   300
         Value           =   0
         Width           =   435
      End
      Begin VIndicator VIndicator1
         BackColor       =   &H00808080&
         BevelInner      =   0  'None
         BevelOuter      =   1  'Raised
         BevelWidth      =   1
         Border          =   1  'Single Width
         BorderWidth     =   1
         Height          =   1515
         Index           =   4
         ItemBackColor   =   &H00000000&
         ItemCount1      =   7
         ItemCount2      =   4
         ItemCount3      =   3
         ItemForeColor1  =   &H0000FF00&
         ItemForeColor2  =   &H0000FFFF&
         ItemForeColor3  =   &H000000FF&
         Left            =   3060
         LinkControl     =   ""
         LinkProperty    =   ""
         Max             =   128
         Min             =   1
         ThreeD          =   -1  'True
         Top             =   300
         Value           =   0
         Width           =   435
      End
      Begin VIndicator VIndicator1
         BackColor       =   &H00808080&
         BevelInner      =   0  'None
         BevelOuter      =   1  'Raised
         BevelWidth      =   1
         Border          =   1  'Single Width
         BorderWidth     =   1
         Height          =   1515
         Index           =   5
         ItemBackColor   =   &H00000000&
         ItemCount1      =   7
         ItemCount2      =   4
         ItemCount3      =   3
         ItemForeColor1  =   &H0000FF00&
         ItemForeColor2  =   &H0000FFFF&
         ItemForeColor3  =   &H000000FF&
         Left            =   3780
         LinkControl     =   ""
         LinkProperty    =   ""
         Max             =   128
         Min             =   1
         ThreeD          =   -1  'True
         Top             =   300
         Value           =   0
         Width           =   435
      End
      Begin VIndicator VIndicator1
         BackColor       =   &H00808080&
         BevelInner      =   0  'None
         BevelOuter      =   1  'Raised
         BevelWidth      =   1
         Border          =   1  'Single Width
         BorderWidth     =   1
         Height          =   1515
         Index           =   6
         ItemBackColor   =   &H00000000&
         ItemCount1      =   7
         ItemCount2      =   4
         ItemCount3      =   3
         ItemForeColor1  =   &H0000FF00&
         ItemForeColor2  =   &H0000FFFF&
         ItemForeColor3  =   &H000000FF&
         Left            =   4500
         LinkControl     =   ""
         LinkProperty    =   ""
         Max             =   128
         Min             =   1
         ThreeD          =   -1  'True
         Top             =   300
         Value           =   0
         Width           =   435
      End
      Begin VIndicator VIndicator1
         BackColor       =   &H00808080&
         BevelInner      =   0  'None
         BevelOuter      =   1  'Raised
         BevelWidth      =   1
         Border          =   1  'Single Width
         BorderWidth     =   1
         Height          =   1515
         Index           =   7
         ItemBackColor   =   &H00000000&
         ItemCount1      =   7
         ItemCount2      =   4
         ItemCount3      =   3
         ItemForeColor1  =   &H0000FF00&
         ItemForeColor2  =   &H0000FFFF&
         ItemForeColor3  =   &H000000FF&
         Left            =   5220
         LinkControl     =   ""
         LinkProperty    =   ""
         Max             =   128
         Min             =   1
         ThreeD          =   -1  'True
         Top             =   300
         Value           =   0
         Width           =   435
      End
      Begin VIndicator VIndicator1
         BackColor       =   &H00808080&
         BevelInner      =   0  'None
         BevelOuter      =   1  'Raised
         BevelWidth      =   1
         Border          =   1  'Single Width
         BorderWidth     =   1
         Height          =   1515
         Index           =   8
         ItemBackColor   =   &H00000000&
         ItemCount1      =   7
         ItemCount2      =   4
         ItemCount3      =   3
         ItemForeColor1  =   &H0000FF00&
         ItemForeColor2  =   &H0000FFFF&
         ItemForeColor3  =   &H000000FF&
         Left            =   5940
         LinkControl     =   ""
         LinkProperty    =   ""
         Max             =   128
         Min             =   1
         ThreeD          =   -1  'True
         Top             =   300
         Value           =   0
         Width           =   435
      End
      Begin VIndicator VIndicator1
         BackColor       =   &H00808080&
         BevelInner      =   0  'None
         BevelOuter      =   1  'Raised
         BevelWidth      =   1
         Border          =   1  'Single Width
         BorderWidth     =   1
         Height          =   1515
         Index           =   9
         ItemBackColor   =   &H00000000&
         ItemCount1      =   7
         ItemCount2      =   4
         ItemCount3      =   3
         ItemForeColor1  =   &H0000FF00&
         ItemForeColor2  =   &H0000FFFF&
         ItemForeColor3  =   &H000000FF&
         Left            =   6660
         LinkControl     =   ""
         LinkProperty    =   ""
         Max             =   128
         Min             =   1
         ThreeD          =   -1  'True
         Top             =   300
         Value           =   0
         Width           =   435
      End
      Begin VIndicator VIndicator1
         BackColor       =   &H00808080&
         BevelInner      =   0  'None
         BevelOuter      =   1  'Raised
         BevelWidth      =   1
         Border          =   1  'Single Width
         BorderWidth     =   1
         Height          =   1515
         Index           =   10
         ItemBackColor   =   &H00000000&
         ItemCount1      =   7
         ItemCount2      =   4
         ItemCount3      =   3
         ItemForeColor1  =   &H0000FF00&
         ItemForeColor2  =   &H0000FFFF&
         ItemForeColor3  =   &H000000FF&
         Left            =   8100
         LinkControl     =   ""
         LinkProperty    =   ""
         Max             =   128
         Min             =   1
         ThreeD          =   -1  'True
         Top             =   300
         Value           =   0
         Width           =   435
      End
      Begin VIndicator VIndicator1
         BackColor       =   &H00808080&
         BevelInner      =   0  'None
         BevelOuter      =   1  'Raised
         BevelWidth      =   1
         Border          =   1  'Single Width
         BorderWidth     =   1
         Height          =   1515
         Index           =   11
         ItemBackColor   =   &H00000000&
         ItemCount1      =   7
         ItemCount2      =   4
         ItemCount3      =   3
         ItemForeColor1  =   &H0000FF00&
         ItemForeColor2  =   &H0000FFFF&
         ItemForeColor3  =   &H000000FF&
         Left            =   7380
         LinkControl     =   ""
         LinkProperty    =   ""
         Max             =   128
         Min             =   1
         ThreeD          =   -1  'True
         Top             =   300
         Value           =   0
         Width           =   435
      End
   End
   Begin Frame Frame4
      BackColor       =   &H00C0C0C0&
      Caption         =   "VU Decay"
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "Small Fonts"
      FontSize        =   6.75
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   2535
      Left            =   8760
      TabIndex        =   0
      Top             =   120
      Width           =   795
      Begin Timer Timer1
         Enabled         =   0   'False
         Interval        =   150
         Left            =   60
         Top             =   2040
      End
      Begin VSlider VSliderVuDecay
         BackColor       =   &H00C0C0C0&
         BevelInner      =   0  'None
         BevelOuter      =   0  'None
         BevelWidth      =   2
         BorderWidth     =   2
         Gap             =   3
         Height          =   2175
         LargeChange     =   10
         Left            =   180
         LinkControl     =   ""
         LinkProperty    =   ""
         Max             =   1
         Min             =   750
         ThumbHeight     =   200
         ThumbStyle      =   0  'Normal
         ThumbWidth      =   295
         TickColor       =   &H00000000&
         TickCount       =   5
         TickLength      =   4
         TickMarks       =   3  'Both
         TickWidth       =   1
         Top             =   240
         TrackBevel      =   0  'None
         TrackWidth      =   0
         Value           =   150
         Width           =   435
      End
   End
   Begin MIDIOutput MIDIOutput1
      DeviceID        =   0
      Left            =   480
      Top             =   3900
      VolumeLeft      =   0
      VolumeRight     =   0
   End
   Begin CommonDialog CMDialog1
      CancelError     =   -1  'True
      DefaultExt      =   "mid"
      DialogTitle     =   "Open MIDI File"
      Filter          =   "(*.mid) MIDI files|*.mid|"
      Left            =   900
      Top             =   3900
   End
   Begin Label LabelTrackName
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   1  'Fixed Single
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "Small Fonts"
      FontSize        =   6
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      ForeColor       =   &H00000000&
      Height          =   600
      Index           =   11
      Left            =   7980
      TabIndex        =   13
      Top             =   2040
      Width           =   735
      WordWrap        =   -1  'True
   End
   Begin Label LabelTrackName
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   1  'Fixed Single
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "Small Fonts"
      FontSize        =   6
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      ForeColor       =   &H00000000&
      Height          =   600
      Index           =   10
      Left            =   7260
      TabIndex        =   12
      Top             =   2040
      Width           =   675
      WordWrap        =   -1  'True
   End
   Begin Label LabelTrackName
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   1  'Fixed Single
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "Small Fonts"
      FontSize        =   6
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      ForeColor       =   &H00000000&
      Height          =   600
      Index           =   9
      Left            =   6540
      TabIndex        =   11
      Top             =   2040
      Width           =   675
      WordWrap        =   -1  'True
   End
   Begin Label LabelTrackName
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   1  'Fixed Single
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "Small Fonts"
      FontSize        =   6
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      ForeColor       =   &H00000000&
      Height          =   600
      Index           =   8
      Left            =   5820
      TabIndex        =   10
      Top             =   2040
      Width           =   675
      WordWrap        =   -1  'True
   End
   Begin Label LabelTrackName
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   1  'Fixed Single
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "Small Fonts"
      FontSize        =   6
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      ForeColor       =   &H00000000&
      Height          =   600
      Index           =   7
      Left            =   5100
      TabIndex        =   9
      Top             =   2040
      Width           =   675
      WordWrap        =   -1  'True
   End
   Begin Label LabelTrackName
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   1  'Fixed Single
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "Small Fonts"
      FontSize        =   6
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      ForeColor       =   &H00000000&
      Height          =   600
      Index           =   6
      Left            =   4380
      TabIndex        =   8
      Top             =   2040
      Width           =   675
      WordWrap        =   -1  'True
   End
   Begin Label LabelTrackName
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   1  'Fixed Single
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "Small Fonts"
      FontSize        =   6
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      ForeColor       =   &H00000000&
      Height          =   600
      Index           =   5
      Left            =   3660
      TabIndex        =   7
      Top             =   2040
      Width           =   675
      WordWrap        =   -1  'True
   End
   Begin Label LabelTrackName
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   1  'Fixed Single
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "Small Fonts"
      FontSize        =   6
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      ForeColor       =   &H00000000&
      Height          =   600
      Index           =   4
      Left            =   2940
      TabIndex        =   6
      Top             =   2040
      Width           =   675
      WordWrap        =   -1  'True
   End
   Begin Label LabelTrackName
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   1  'Fixed Single
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "Small Fonts"
      FontSize        =   6
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      ForeColor       =   &H00000000&
      Height          =   600
      Index           =   3
      Left            =   2220
      TabIndex        =   5
      Top             =   2040
      Width           =   675
      WordWrap        =   -1  'True
   End
   Begin Label LabelTrackName
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   1  'Fixed Single
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "Small Fonts"
      FontSize        =   6
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      ForeColor       =   &H00000000&
      Height          =   600
      Index           =   2
      Left            =   1500
      TabIndex        =   4
      Top             =   2040
      Width           =   675
      WordWrap        =   -1  'True
   End
   Begin Label LabelTrackName
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   1  'Fixed Single
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "Small Fonts"
      FontSize        =   6
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      ForeColor       =   &H00000000&
      Height          =   600
      Index           =   1
      Left            =   780
      TabIndex        =   3
      Top             =   2040
      Width           =   675
      WordWrap        =   -1  'True
   End
   Begin Label LabelTrackName
      BackColor       =   &H00C0C0C0&
      BorderStyle     =   1  'Fixed Single
      FontBold        =   0   'False
      FontItalic      =   0   'False
      FontName        =   "Small Fonts"
      FontSize        =   6
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      ForeColor       =   &H00000000&
      Height          =   600
      Index           =   0
      Left            =   60
      TabIndex        =   2
      Top             =   2040
      Width           =   675
      WordWrap        =   -1  'True
   End
   Begin Menu FileMenu
      Caption         =   "&File"
      Begin Menu FileOpen
         Caption         =   "&Open..."
         Shortcut        =   ^O
      End
      Begin Menu FileSep1
         Caption         =   "-"
      End
      Begin Menu FileExit
         Caption         =   "E&xit"
      End
   End
End
Option Explicit

Dim lVolume As Integer
Dim rVolume As Integer

Dim PreviousTime As Long

Dim msPerTick As Single
Dim ticksPerMs As Single

Dim CurrentTime As Long

Sub CloseOutputDevice ()
    '
    ' Restore volume before closing
    '
    If MIDIOutput1.State >= MIDISTATE_OPEN Then
    If (MIDIOutput1.HasLRVolume) Then
        MIDIOutput1.VolumeLeft = lVolume
        MIDIOutput1.VolumeRight = rVolume
    ElseIf (MIDIOutput1.HasVolume) Then
        MIDIOutput1.VolumeLeft = lVolume
    End If
    '
    ' Close
    '
    MIDIOutput1.Action = MIDIOUT_CLOSE
    End If
End Sub

Sub CmdPlay_Click ()
    StartPlay
    Timer1.Enabled = True
End Sub

Sub CmdQueue_Click ()
    QueueSong
End Sub

Sub CmdStop_Click ()
    screen.MousePointer = 11
    StopPlay
    Timer1.Enabled = False
    screen.MousePointer = 0
End Sub

Sub DisplayTrackNames ()
    Dim m As Integer
    Dim t As Integer

    For m = 0 To 11
    LabelTrackName(m) = ""
    Next


    For t = 1 To MIDIFile1.NumberOfTracks
    If (t = 1) Then
        msPerTick = ((MIDIFile1.Tempo) / 1000) / MIDIFile1.TicksPerQuarterNote
        ticksPerMs = (MIDIFile1.TicksPerQuarterNote / MIDIFile1.Tempo) * 1000
    ElseIf t <= 13 Then
        LabelTrackName(t - 2).Caption = GetTrackName(t)
        'Put 3D effect on label control
        HighLight LabelTrackName(t - 2), 2
    End If
    Next

End Sub

Sub FileExit_Click ()
    End
End Sub

Sub FileOpen_Click ()
    On Error Resume Next
    CMDialog1.DialogTitle = "Open MIDI File"
    CMDialog1.Flags = &H1000&
    CMDialog1.Action = 1
    If (Err) Then
    Exit Sub
    End If
    MIDIFile1.Filename = CMDialog1.Filename
    MIDIFile1.Action = MIDIFILE_OPEN
    DisplayTrackNames
    CmdQueue_Click
End Sub

Sub Form_Load ()
    Dim I As Integer

    Form1.Left = 0
    Form1.Top = 0

    ' Fill output device combo box
    For I = -1 To MIDIOutput1.DeviceCount - 1
    MIDIOutput1.DeviceID = I
    OutputDevCombo.AddItem MIDIOutput1.ProductName
    Next

    ' Select first in list
    MIDIOutput1.DeviceID = -1
    OutputDevCombo.ListIndex = 0

    Form1.Show
    CmdQueue.Enabled = False
    CmdStop.Enabled = False
    CmdPlay.Enabled = False
End Sub

Sub Form_QueryUnload (Cancel As Integer, UnloadMode As Integer)
    Cancel = True
End Sub

Sub Form_Unload (Cancel As Integer)
    CloseOutputDevice
End Sub

Function GetTrackName (Track As Integer) As String
    Dim I As Integer

    MIDIFile1.TrackNumber = Track

    For I = 1 To MIDIFile1.MessageCount
    MIDIFile1.MessageNumber = I
    '
    'Meta Event
    '
    If (MIDIFile1.Message = 255) And MIDIFile1.Data1 = 3 Then
        If (MIDIFile1.MsgText = "") Then
        GetTrackName = "Track" & Str(Track) & " (null)"
        Else
        GetTrackName = MIDIFile1.MsgText
        End If
        Exit Function
    End If
    Next
    GetTrackName = "Track" & Str(Track)
End Function

Sub MIDIOutput1_Error (ErrorCode As Integer, ErrorMessage As String)
    MsgBox ErrorMessage
End Sub

Sub MIDIOutput1_MessageSent (MessageTag As Long)
    Dim TrackNumber As Integer

    TrackNumber = Int(MessageTag / 1000) - 2


    If Val(Right(MessageTag, 3)) > 1 And TrackNumber < 12 Then
    VIndicator1(TrackNumber).Value = Val(Right(MessageTag, 3))
    End If
End Sub

Sub MIDIOutput1_QueueEmpty ()
    Dim n As Integer
    StopPlay

End Sub

Sub MidiReset ()
    Dim x As Integer
    Dim y As Integer

    'Reset VU Meters to 0
    For y = 0 To 11
    VIndicator1(y).Value = 0
    Next

    'Turn off all MIDI Notes on all channels.
    For x = 176 To 191
      MIDIOutput1.Message = x
      MIDIOutput1.Data1 = 123
      MIDIOutput1.Data2 = 0
      MIDIOutput1.Action = MIDIOUT_SEND
    Next
    MIDIOutput1.Action = MIDIOUT_STOP

End Sub

Sub OpenOutputDevice ()
    '
    ' Restore defaults
    '
    PlaybackRateSlider = 0
    '
    ' Open selected device
    '
    MIDIOutput1.DeviceID = OutputDevCombo.ListIndex - 1
    MIDIOutput1.Action = MIDIOUT_OPEN
    '
    ' Save volume if opened ok
    '
    If (MIDIOutput1.HMidiDevice <> 0) Then
    '
    ' If device supports volume, save starting volume
    '
    If (MIDIOutput1.HasLRVolume) Then
        lVolume = MIDIOutput1.VolumeLeft
        rVolume = MIDIOutput1.VolumeRight
    ElseIf (MIDIOutput1.HasVolume) Then
        lVolume = MIDIOutput1.VolumeLeft
    End If
    End If
End Sub

Sub OutputDevCombo_Click ()
    '
    ' Stop and Close currently opened device (if any)
    '
    'StopPlay
End Sub

Sub QueueSong ()
    Select Case MIDIFile1.Format
    Case Is = 0 'MIDI file type 0 (single track)
        QueueSongType0
    Case Is = 1 'MIDI File type 1 (multi track)
        screen.MousePointer = 11
        QueueSongType1

    End Select
End Sub

Sub QueueSongType0 ()
    Dim m As Integer
    Dim mm As Integer
    Dim I As Integer
    ReDim CurrentTimeQueue(MIDIFile1.NumberOfTracks) As Long
    ReDim PreviousTimeQueue(MIDIFile1.NumberOfTracks) As Long
    ReDim LowestEvent(MIDIFile1.NumberOfTracks) As Long

    ReDim TrackDone(1) As Integer
    Dim TracksLoadComplete As Integer
    Dim Startme As Integer
    Dim IncrementAmount As Integer

    LowestEvent(1) = 1
    TrackDone(1) = False

    LabelTrackName(0) = "Track 1"

    IncrementAmount = 1000

    screen.MousePointer = 11

    Do While TracksLoadComplete = False
    If TrackDone(1) = False Then
        'Increment throught in groups of IncrementAmount events
        If MIDIFile1.MessageCount > LowestEvent(1) + IncrementAmount Then
        mm = LowestEvent(1) + IncrementAmount
        Else
        mm = MIDIFile1.MessageCount
        End If

        For m = LowestEvent(1) To mm
        I = DoEvents()
        MIDIFile1.MessageNumber = m

        If m = IncrementAmount Then
            CmdPlay.Enabled = True
            CmdQueue.Enabled = False
            CmdStop.Enabled = False
             screen.MousePointer = 0
        End If

        ' Put message data in control
        MIDIOutput1.Message = MIDIFile1.Message
        MIDIOutput1.Data1 = MIDIFile1.Data1
        MIDIOutput1.Data2 = MIDIFile1.Data2

        'Tag notes to play on keyboard and VU meters
        If MIDIFile1.Message <= 159 And MIDIFile1.Message >= 144 Then
            MIDIOutput1.MessageTag = MIDIFile1.Data2 + 1 + (2 * 1000)
        End If

        CurrentTimeQueue(1) = PreviousTimeQueue(1) + MIDIFile1.Time

        MIDIOutput1.Time = Int(CurrentTimeQueue(1) * msPerTick)
        PreviousTimeQueue(1) = CurrentTimeQueue(1)

        ' Add to output queue
        MIDIOutput1.Action = MIDIOUT_QUEUE
        Next
        If mm = MIDIFile1.MessageCount Then
        TrackDone(1) = True
        TracksLoadComplete = TracksLoadComplete + 1
        Else
        LowestEvent(1) = LowestEvent(1) + IncrementAmount + 1
        End If
    End If
    Loop
End Sub

Sub QueueSongType1 ()
    Dim m As Integer
    Dim mm As Integer
    Dim Track As Integer
    Dim I As Integer
    ReDim CurrentTimeQueue(MIDIFile1.NumberOfTracks) As Long
    ReDim PreviousTimeQueue(MIDIFile1.NumberOfTracks) As Long
    ReDim LowestEvent(MIDIFile1.NumberOfTracks) As Long

    ReDim TrackDone(MIDIFile1.NumberOfTracks) As Integer
    Dim TracksLoadComplete As Integer
    Dim Startme As Integer
    Dim IncrementAmount As Integer

    For m = 1 To MIDIFile1.NumberOfTracks
    LowestEvent(m) = 1
    TrackDone(m) = False
    Next m

    'Since first track doesn't need to be queued
    TracksLoadComplete = 1

    IncrementAmount = 225

    Do While TracksLoadComplete < MIDIFile1.NumberOfTracks

    For Track = 2 To MIDIFile1.NumberOfTracks
    MIDIFile1.TrackNumber = Track

    If TrackDone(Track) = False Then
        'Increment throught in groups of IncrementAmount events
        If MIDIFile1.MessageCount > LowestEvent(Track) + IncrementAmount Then
        mm = LowestEvent(Track) + IncrementAmount
        Else
        mm = MIDIFile1.MessageCount
        End If

        For m = LowestEvent(Track) To mm
        I = DoEvents()
        MIDIFile1.MessageNumber = m

        ' Put message data in control
        MIDIOutput1.Message = MIDIFile1.Message
        MIDIOutput1.Data1 = MIDIFile1.Data1
        MIDIOutput1.Data2 = MIDIFile1.Data2

        'Tag notes to play on keyboard and VU meters
        If MIDIFile1.Message <= 159 And MIDIFile1.Message >= 144 Then
            MIDIOutput1.MessageTag = MIDIFile1.Data2 + 1 + (Track * 1000)
        End If

        CurrentTimeQueue(Track) = PreviousTimeQueue(Track) + MIDIFile1.Time

        MIDIOutput1.Time = Int(CurrentTimeQueue(Track) * msPerTick)
        PreviousTimeQueue(Track) = CurrentTimeQueue(Track)

        ' Add to output queue
        MIDIOutput1.Action = MIDIOUT_QUEUE
        Next
        If mm = MIDIFile1.MessageCount Then
        TrackDone(Track) = True
        TracksLoadComplete = TracksLoadComplete + 1
        Else
        LowestEvent(Track) = LowestEvent(Track) + IncrementAmount + 1
        End If
    End If
    Next

    'If 225 events have been loaded from each track then
    'let playback start.
    If screen.MousePointer = 11 Then
    screen.MousePointer = 0
    CmdPlay.Enabled = True
    CmdQueue.Enabled = False
    CmdStop.Enabled = False
    End If
    Loop
End Sub

Sub QueueTrack (Track As Integer)
    Dim m As Integer
    Dim I As Integer
    Dim CurrentTime As Long

    screen.MousePointer = 11

    MIDIFile1.TrackNumber = Track

    For m = 1 To MIDIFile1.MessageCount

    I = DoEvents()

    MIDIFile1.MessageNumber = m
    '
    'Meta Event
    '
    If (MIDIFile1.Message = 255) Then
        Select Case MIDIFile1.Data1
        Case 0 To 7, &H7F
            If (Len(MIDIFile1.Buffer) > 3) Then
            I = 2
            Do While (Val("&H" & Mid$(MIDIFile1.Buffer, I, 1)) And &H80)
                I = I + 1
            Loop
            MIDIFile1.MsgText = Right$(MIDIFile1.Buffer, Len(MIDIFile1.Buffer) - 1)
            Else
            MIDIFile1.Buffer = ""
            End If
        End Select
    End If

    ' Put message data in control
    MIDIOutput1.Message = MIDIFile1.Message
    MIDIOutput1.Data1 = MIDIFile1.Data1
    MIDIOutput1.Data2 = MIDIFile1.Data2

    ' Set the MessageTag property with the value of the track and velocity
    ' When the MIDI message is sent from the MIDIOutput, the MessageSent event will
    ' be fired and the MessageTag is passed.  Examine the MIDIOutput1 MessageSent event
    ' to see this happening with each message.
    If MIDIFile1.Message <= 159 And MIDIFile1.Message >= 128 Then
        MIDIOutput1.MessageTag = MIDIFile1.Data2 + 1 + (MIDIFile1.Message * 1000) + (MIDIFile1.Data1 * 1000000)
    End If

    CurrentTime = PreviousTime + MIDIFile1.Time

    MIDIOutput1.Time = Int(CurrentTime * msPerTick)
    PreviousTime = CurrentTime
    '
    ' Add to output queue
    '
    MIDIOutput1.Action = MIDIOUT_QUEUE
    Next
    screen.MousePointer = 0
End Sub

Sub StartPlay ()
    OpenOutputDevice
    MIDIOutput1.Action = MIDIOUT_START
    CmdPlay.Enabled = False
    CmdQueue.Enabled = False
    CmdStop.Enabled = True
End Sub

Sub StopPlay ()
    CmdStop.Enabled = False

    MIDIOutput1.Action = MIDIOUT_STOP
    MidiReset
    CloseOutputDevice

    CmdPlay.Enabled = False
    CmdQueue.Enabled = True
End Sub

Sub Timer1_Timer ()
    Dim n As Integer
    For n = 0 To 11
    If VIndicator1(n).Value > 0 Then
       VIndicator1(n).Value = Int(VIndicator1(n).Value / 2 - .5)
    End If
    Next
End Sub

Sub VSliderVuDecay_Scroll ()
    Timer1.Interval = VSliderVuDecay.Value
End Sub